#+TITLE: The Seasoned Schemer Notes
#+SUBTITLE: Chapter 14
#+AUTHOR: Zelphir Kaltstahl
#+DATE: [2023-11-26 Sun]
#+LANGUAGE: English
#+TAGS: Scheme, The Seasoned Schemer
#+CREATOR: Emacs
#+EXCLUDE_TAGS: noexport
#+OPTIONS: ^:{} H:10 toc:3
#+STARTUP: content indent align inlineimages hideblocks entitiesplain nologdone nologreschedule nologredeadline nologrefile

* Prerequisites
:PROPERTIES:
:CUSTOM_ID: prerequisites
:END:

src_scheme[:exports code]{atom?} checks, whether a thing is a non-compound thing, at least for simple code, that does not make use of vector and such things.

#+NAME: atom-def
#+BEGIN_SRC scheme :noweb strip-export :results none :exports code :eval never-export
(define atom?
  (λ (x)
    (and (not (pair? x))
         (not (null? x)))))
#+end_src

* Chapter 14
:PROPERTIES:
:CUSTOM_ID: chapter-14
:END:

+ This chapter introduces src_scheme[:exports code]{if}.
+ This chapter introduces src_scheme[:exports code]{letcc} and src_scheme[:exports code]{call-with-current-continuation}.
+ This chapter introduces src_scheme[:exports code]{try}.
+ This chapter shows more ways of making use of continuations for various purposes.

** Attempt to write src_scheme[:exports code]{leftmost}
:PROPERTIES:
:CUSTOM_ID: chapter-14-attempt-leftmost
:END:

src_scheme[:exports code]{leftmost} returns the leftmost atom of a nested list or tree.

#+NAME: leftmost-def-attempt-1
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports code :eval never-export :language guile
<<atom-def>>
(define leftmost
  (λ (lst)
    (cond
     [(null? lst) '()]
     [(atom? (car lst))
      (car lst)]
     ;; We know car of lst is not an atom and it is not null?, so
     ;; it must be at least a pair. We have to try to find the
     ;; leftmost element in that pair.
     [else
      (leftmost (car lst))])))
#+end_src

#+NAME: leftmost-usage-attempt-1
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports both :eval never-export :language guile
<<leftmost-def-attempt-1>>
(simple-format #t "~a\n" (leftmost '(((() c) (a) (d) b) e)))
#+end_src

#+RESULTS: leftmost-usage-attempt-1
#+begin_example
()
#+end_example

But this is not correct. The leftmost element should be src_scheme[:exports code]{'c}. Maybe we can try to find the leftmost element in the src_scheme[:exports code]{car} of src_scheme[:exports code]{lst} and if we do not find it, search in the src_scheme[:exports code]{cdr} of src_scheme[:exports code]{lst}:

#+NAME: leftmost-def-attempt-2
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports code :eval never-export :language guile
<<atom-def>>
(define leftmost
  (λ (lst)
    (cond
     [(null? lst) '()]
     [(atom? (car lst))
      (car lst)]
     [else
      (let ([leftmost-of-car (leftmost (car lst))])
        (cond
         [(null? leftmost-of-car) (leftmost (cdr lst))]
         [else leftmost-of-car]))])))
#+end_src

#+NAME: leftmost-usage-attempt-2
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports both :eval never-export :language guile
<<leftmost-def-attempt-2>>
(simple-format #t "~a\n" (leftmost '(((() c) (a) (d) b) e)))
(simple-format #t "~a\n" (leftmost '((((f) c) (a) (d) b) e)))
#+end_src

#+RESULTS: leftmost-usage-attempt-2
#+begin_example
c
f
#+end_example

This seems to work. No continuations needed so far.

The book has a slightly better solution, which asks src_scheme[:exports code]{atom?} instead of src_scheme[:exports code]{null?} about the src_scheme[:exports code]{leftmost} of the src_scheme[:exports code]{car} of a list. This is clearer, since we are actually interested in getting the src_scheme[:exports code]{leftmost} atom, and not the src_scheme[:exports code]{leftmost} src_scheme[:exports code]{null?} and as such do not need to invert the thinking. My solution also works, but only because it has the convention of returning src_scheme[:exports code]{'()} when src_scheme[:exports code]{(null? lst)} is src_scheme[:exports code]{#t}. The book's solution does not rely on the returned thing being exactly src_scheme[:exports code]{'()}, so it has fewer conventions backed in and is more flexible than my solution.

** Attempt to write src_scheme[:exports code]{rember1*}
:PROPERTIES:
:CUSTOM_ID: chapter-14-attempt-rember-1-asterisk
:END:

src_scheme[:exports code]{rember1*} removes the leftmost occurrence of an element satisfying a predicate from an arbitrarily nested list. The version in the book works with atoms. My version here should work even with compound values.

#+NAME: rember-1-asterisk-def-attempt-1
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports code :eval never-export :language guile
(import (srfi srfi-11))

<<atom-def>>

(define rember1*
  (λ (lst pred)
    (letrec ([rember-inner
              (λ (lst)
                (cond
                 [(null? lst) (values #f '())]
                 [(pred (car lst)) (values #t (cdr lst))]
                 [(atom? (car lst))
                  (let-values ([(changed-flag result-of-cdr)
                                (rember-inner (cdr lst))])
                    (values changed-flag
                            (cons (car lst)
                                  result-of-cdr)))]
                 [else
                  (let-values ([(changed-flag result-of-car)
                                (rember-inner (car lst))])
                    (cond
                     [changed-flag
                      (values changed-flag
                              (cons result-of-car (cdr lst)))]
                     [else
                      (let-values ([(changed-flag result-of-cdr)
                                    (rember-inner (cdr lst))])
                        (values changed-flag
                                (cons (car lst)
                                      result-of-cdr)))]))]))])
      (let-values ([(changed-flag result)
                    (rember-inner lst)])
        result))))
#+end_src

#+NAME: rember-1-asterisk-usage-attempt-1
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports both :eval never-export :language guile
<<rember-1-asterisk-def-attempt-1>>
(simple-format
 #t "~a\n"
 (rember1* '(a (e f g) b (d e f) c d)
           (λ (elem) (eq? elem 'e))))

(simple-format
 #t "~a\n"
 (rember1* '(a (f g) b (d e f) c d)
           (λ (elem) (eq? elem 'e))))

(simple-format
 #t "~a\n"
 (rember1* '(a (f g) b (d f) c d)
           (λ (elem) (eq? elem 'e))))

(simple-format
 #t "~a\n"
 (rember1* '(a (e f g) b (d e f) c d)
           (λ (elem) (equal? elem '(e f g)))))
#+end_src

#+RESULTS: rember-1-asterisk-usage-attempt-1
#+begin_example
(a (f g) b (d e f) c d)
(a (f g) b (d f) c d)
(a (f g) b (d f) c d)
(a b (d e f) c d)
#+end_example

This works, but the whole src_scheme[:exports code]{let-values} thing is a bit cumbersome. Furthermore src_scheme[:exports code]{let-values} has not been introduced in the book at that point. One could of course use a pair or list as a result type as well. Maybe the book has a better solution? Maybe some clever idea with a continuation?

The book solves it with an equality function src_scheme[:exports code]{eqlist?}, which is used to compare the src_scheme[:exports code]{car} of the list, with the src_scheme[:exports code]{car} of the list, that potentially has an element removed. Depending on the result of that comparison, it decides to also apply src_scheme[:exports code]{rember1*} whether to the src_scheme[:exports code]{cdr} of the list or not. There is an inefficiency in that solution though: We already know, whether we changed something by removing an element of the list in the src_scheme[:exports code]{car} of the list. If we could return that information, we would not need to do any comparison. This is done in my solution using src_scheme[:exports code]{let-values}, but could also be done using a pair or list, if one wanted to avoid src_scheme[:exports code]{let-values}.

** Using continuations to avoid conditionals
:PROPERTIES:
:CUSTOM_ID: chapter-14-avoid-conditionals
:END:

The idea is, that often one already knows some fact deeper in recursive calls, but loses that knowledge, when returning values to earlier recursive calls, so one should make use of the knowledge at deeper levels of recursion.

Sometimes it takes multiple levels of recursive calls to get to the decisive facts or knowledge. One does not always know ahead of time how to process the return value of recursive calls. It can for example happen, that there is a success case and a failure case. In the success case one might want to put the result values in some kind of data structure (say a list by using cons for example) and in the failure case one might not want to do anything at all with the return values. But one cannot know at this level of recursion whether it will be a success or failure case. Optimistically adding the return values to a data structure might lead to a wrong result. Discarding the return values pessimistically might overlook correct or relevant return values and also lead to a wrong result.

There are a few ideas how this can be handled in general:

1. Run checks on the returned values of recursive calls. Possibly performing redundant checks that already ran as part of deeper levels of recursive calls.
2. Return all required knowledge in return values up to earlier recursive calls, not merely returning the usual return value, but also knowledge or facts. For example by returning a list or multiple values. The returned knowledge should have a representation, which allows for low-cost checks by the level of the recursion, that needs to run checks on that knowledge. For example the additionally returned facts could be booleans and a check could be, whether some boolean is true or false.
3. Create a kind of entrypoint to further execution, a continuation, and pass it along with in recursive calls, so that deeper levels of the recursion can decide whether or not to make use of that continuation, depending on their knowledge.
4. The ugly one: Use an exception, even though no actually exceptional situation is encountered, to jump back to where that exception is handled. This can be seen as a special case of using a continuation though.
5. Use an other kind of concept that the language used offers. For example GNU Guile offers something called "prompts".

Here we take a look at option 3, using continuations to avoid redundant checks.

The following function shows a way to avoid checking the result of a recursive call.

#+NAME: leftmost-def-3
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports code :eval never-export :language guile
<<atom-def>>
(define leftmost
  (λ (lst)
    (call-with-current-continuation
     (λ (return)
       (define inner
         (λ (lst°)
           (cond
            [(null? lst°) '()]
            [(atom? (car lst°)) (return (car lst°))]
            [else
             (inner (car lst°))
             (inner (cdr lst°))])))
       (inner lst)))))
#+end_src

What happens here?

The first call to src_scheme[:exports code]{inner} inside the src_scheme[:exports code]{else} branch of the src_scheme[:exports code]{cond} may or may not find an src_scheme[:exports code]{atom?} in the src_scheme[:exports code]{car}. If it finds an src_scheme[:exports code]{atom?}, it will call the continuation src_scheme[:exports code]{return} to return it and we forget about running all other memorized calls to src_scheme[:exports code]{inner}. If it does not find an src_scheme[:exports code]{atom?}, it will return the empty list src_scheme[:exports code]{'()}. Nothing is done with that return value and the second call to src_scheme[:exports code]{inner} with the src_scheme[:exports code]{cdr} of the list is performed.

We could have checked the return value instead, to see whether it is an src_scheme[:exports code]{atom?} or the empty list and based on that decide to search for a src_scheme[:exports code]{leftmost} src_scheme[:exports code]{atom?} in the src_scheme[:exports code]{cdr}, but that check would have been redundant, since we already know, whether it is an src_scheme[:exports code]{atom?} in a deeper recursion.

#+NAME: leftmost-usage-3
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports both :eval never-export :language guile
<<leftmost-def-3>>
(simple-format
 #t "~a\n"
 (leftmost '(((a)) b (c))))

(simple-format
 #t "~a\n"
 (leftmost '((()) b (c))))

(simple-format
 #t "~a\n"
 (leftmost '(((c a)) b (c))))

(simple-format
 #t "~a\n"
 (leftmost '(())))

(simple-format
 #t "~a\n"
 (leftmost '(a b c d)))
#+end_src

#+RESULTS: leftmost-usage-3
#+begin_example
a
b
c
()
a
#+end_example

** When are continuations "needed"?
:PROPERTIES:
:CUSTOM_ID: chapter-14-continuations-needed
:END:

*** Unknown success for recursive calls
:PROPERTIES:
:CUSTOM_ID: chapter-14-continuations-needed-success-of-recursive-calls
:END:

One scenario in which continuations or another concept that replaces them are needed, when it is not clear at the time of a recursive call, whether the call will achieve the overall goal of the function. For example the book gives code for a function, that removes an element fulfilling a test from an arbitrarily nested list, similar to the following:

#+NAME: rm-def
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports code :eval never-export :language guile
<<atom-def>>
(define rm
  (λ (elem lst back-out)
    (cond
     [(null? lst)
      ;; If the element cannot be found in the list, call the
      ;; continuation back-out, to return to the recursive call and
      ;; forget already accumulated conses.
      (back-out 'no)]
     ;; The next branch checks, whether the car of the list is an atom
     ;; and that atom fulfills the predicate we choose. In this case
     ;; the predicate is, that it needs to be an atom? and that it
     ;; must be eq? to the element we are searching for. But any other
     ;; test would be possible as well.
     [(atom? (car lst))
      (if (eq? (car lst) elem)
          ;; If the car is the element we are looking for, simply drop
          ;; it.
          (cdr lst)
          ;; Otherwise keep the car, but look at the cdr of the list.
          (cons (car lst)
                (rm elem
                    (cdr lst)
                    ;; Keep using the same continuation. There is no
                    ;; need to create a new continuation here. If the
                    ;; element cannot be found in the cdr of the list
                    ;; at all, we want to jump back out to the level
                    ;; above, not back here.
                    back-out)))]
     [else
      (let ([new-car
             ;; Try to remove the element from the car of the list. It
             ;; might or might not exist there. If it exists a
             ;; resulting car will be returned, otherwise rm should
             ;; call the continuation with an atom as an argument.

             ;; Note, that the continuation is created at each point,
             ;; where there is a car and a cdr of the list, and that
             ;; we only jump back out by 1 level. Depending on the
             ;; result of the expression for new-car, we continue from
             ;; that level, potentially having to look at the cdr of
             ;; the list for removing the searched element. Jumping
             ;; back out does not jump all the way up the function
             ;; call stack.
             (call-with-current-continuation
              (λ (back-out)
                (rm elem
                    (car lst)
                    back-out)))])
        ;; Check, whether new-car is an atom?, as in the case, that
        ;; the continuation to back out was called.
        (if (atom? new-car)
            ;; When the element cannot be found in the car of the
            ;; list, the continuation back-out is called using an atom
            ;; 'no. Otherwise it is not called and the result of the
            ;; expression for new-car will be the car of the list with
            ;; that one element being removed. If the new-car is an
            ;; atom, then the element was not removed from it. That
            ;; means the car should stay as is and we need to check
            ;; the cdr of the list for the element to remove.
            (cons (car lst)
                  (rm elem
                      (cdr lst)
                      back-out))
            ;; Otherwise we are done, because the element was already
            ;; removed in new-car. We only need to construct the list
            ;; as a result.
            (cons new-car
                  (cdr lst))))])))
#+end_src

This function already expects a continuation as an argument. The idea is, that, if element cannot be found in the whole list, the list stays the same. So instead of backing out and trying to remove it from the cdr of the list, a different logic is required: Keep the whole list.:

#+NAME: rember-1-asterisk-def
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports code :eval never-export :language guile
<<atom-def>>
<<rm-def>>
(define rember1*
  (λ (elem lst)
    (let ([new-list
           (call-with-current-continuation
            (λ (back-out)
              (rm elem lst back-out)))])
      ;; Here comes the different logic to handle the result of the
      ;; call-with-current-continuation.
      (if (atom? new-list)
          lst
          new-list))))
#+end_src

We can use it as follows:

#+NAME: rember-1-asterisk-usage
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports both :eval never-export :language guile
<<rember-1-asterisk-def>>
(simple-format
 #t "~a\n"
 (rember1* 'a '(b c (d (a) e) f g h a)))
#+end_src

#+RESULTS: rember-1-asterisk-usage
#+begin_example
(b c (d () e) f g h a)
#+end_example

Now contrast this with a function, that is recursive as well, but which does not need continuations. For example the function src_scheme[:exports code]{alist-set*}, which functionally updates an arbitrarily nested association list:

#+NAME: alist-imports
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports none :eval never-export :language guile
(import (rnrs base)
        (only (guile)
              lambda* λ)
        ;; GNU Guile batteries
        (ice-9 exceptions)
        ;; SRFIs
        ;; SRFI 1 - list procs
        (srfi srfi-1))
#+end_src

#+NAME: alistp-shallow
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports none :eval never-export :language guile
(define alist?-shallow
  (λ (lst)
    "Check, whether LST is an association list, by only looking
at the first item."
    (cond
     [(null? lst) #t]
     [(pair? lst)
      (pair? (first lst))]
     [else #f])))
#+end_src

#+NAME: alist-set-asterisk-def
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports code :eval never-export :language guile
<<alist-imports>>
<<alistp-shallow>>
(define alist-set*
  (lambda* (alst keys val #:key (equal-test equal?))
    "Set value VAL inside the alist ALST navigating through its
keys using KEYS to get to the place where VAL shall be the
new value."
    (define traverse
      (λ (alst keys)
        (cond
         [(null? keys) val]
         [(not (alist?-shallow alst))
          (raise-exception
           (make-exception (make-non-continuable-error)
                           (make-exception-with-message "key not found")
                           (make-exception-with-irritants keys)
                           (make-exception-with-origin 'alist-set*)))]
         [(null? alst) (cons (cons (first keys)
                                   val)
                             '())]
         [else
          (let ([current-assoc (first alst)]
                [item-key (car (first alst))])
            (cond
             [(equal-test item-key (first keys))
              ;; Change the value and cons the rest of the list.
              (cons (cons item-key
                          (traverse (cdr current-assoc)
                                    (drop keys 1)))
                    (drop alst 1))]
             [else
              (cons current-assoc
                    (traverse (drop alst 1) keys))]))])))
    (traverse alst keys)))
#+end_src

Usage:

#+NAME: alist-set-asterisk-usage
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports both :eval never-export :language guile
<<alist-set-asterisk-def>>
(define myalist '((a . 1)
                  (b .
                     ((d . 4)
                      (e . 5)))
                  (c . 3)))

(simple-format
 #t "~a\n"
 (alist-set* myalist '(c) (list (cons 'f 10)) #:equal-test eq?))
#+end_src

#+RESULTS: alist-set-asterisk-usage
#+begin_example
((a . 1) (b (d . 4) (e . 5)) (c (f . 10)))
#+end_example

In src_scheme[:exports code]{alist-set*} we can build up conses correctly without ever building up conses, that we later need to discard, because we get a list of keys, which indicate which association we need to follow, in order to get to the item we are interested in. If such an item does not exist or its keys do not exist, an exception is raised (which could be implemented using continuations, but that would be using continuations for another purpose than src_scheme[:exports code]{rm} does). If such an item is found, all the conses up to that point are correct and needed. The keys allow us to be sure, that we do not need to back out and look at other associations.

We also would not need continuations for src_scheme[:exports code]{rm}, if it did not only remove one occurrence of the searched element, but all of them. Such a function would not need to forget about conses, but could always check the car and the cdr of a list for occurrences and return for both a potentially updated version. Both branches, the one for the car and the one for the cdr, would always succeed.

** Using continuations to build other control flow forms
:PROPERTIES:
:CUSTOM_ID: chapter-14-continuations-for-control-flow
:END:

The book shows an intersting control flow form named src_scheme[:exports code]{try}, which is implemented using continuations. The book uses src_scheme[:exports code]{letcc}, but here is a slightly different form using src_scheme[:exports code]{call-with-current-continuation}:

#+NAME: try-def
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports code :eval never-export :language guile
(define try
  (λ (proc alternative-proc)
    ;; Remember a continuation, which can be used to return a result
    ;; for try, if proc succeeds. A success continuation.
    (call-with-current-continuation
     (λ (success)
       ;; Create a continuation, which is used in case of failure of
       ;; the given proc.
       (call-with-current-continuation
        (λ (failure)
          ;; The procedure `proc' receives the failure
          ;; continuation. If it ever calls the continuation with any
          ;; value, there will be a result to the
          ;; call-with-current-continuation expression for the failure
          ;; case. The failure case continuation is one expression
          ;; inside the body of a lambda. This means, that after the
          ;; expression is evaluated (has a result), the next
          ;; expression will be evaluated, which is the call to
          ;; `alternative-proc'.

          ;; If instead the call to `proc' returns, without ever
          ;; calling `failure', then `success' is instead called,
          ;; which jumps out of the lambda and forgets/ignores the
          ;; call to `alternative-proc'.

          ;; The result of the call to `success' will be the result of
          ;; the whole expression `try'.
          (success (proc failure))))
       (alternative-proc)))))
#+end_src

Using this src_scheme[:exports code]{try} definition, we can rewrite src_scheme[:exports code]{rember1*}:

#+NAME: try-usage
#+begin_src scheme :noweb strip-export :results output replace drawer :wrap example :exports both :eval never-export :language guile
<<atom-def>>
<<try-def>>
<<rm-def>>
(define rember1*
  (λ (elem lst)
    (try (λ (failure-cont)
           (rm elem lst failure-cont))
         (λ () lst))))


(simple-format
 #t "success case: removing 'a: ~a\n"
 (rember1* 'a
           '(b c (d (a) e) f g h a)))

(simple-format
 #t "failure case: remaining as is: ~a\n"
 (rember1* 'a
           '(b c (d (x) e) f g h x)))
#+end_src

#+RESULTS: try-usage
#+begin_example
success case: removing 'a: (b c (d () e) f g h a)
failure case: remaining as is: (b c (d (x) e) f g h x)
#+end_example

Of course, defining src_scheme[:exports code]{try} as a macro could even get rid of the need to write the lambdas in the call of src_scheme[:exports code]{try}, to make it even more natural.

This is also a great example of how continuation passing style (CPS) is very powerful and can make special language constructs unnecessary, even if difficult to read to the untrained eye.
